home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 2000 November: Tool Chest / Dev.CD Nov 00 TC Disk 1.toast / Sample Code / Networking / OTStreamLogViewer / IC Libraries / ICMiscSubs.p < prev    next >
Encoding:
Text File  |  2000-09-28  |  24.9 KB  |  779 lines  |  [TEXT/CWIE]

  1. unit ICMiscSubs;
  2.  
  3. (*    This file is part of the Internet Configuration system and is placed in the public domain for the benefit of all.
  4.  
  5.     This file holds all those miscellaneous little functions that are basically wrappers
  6.     around existing OS functionality.
  7. *)
  8.  
  9. interface
  10.  
  11.     uses
  12.         Files,
  13.         Windows,
  14.         Lists, 
  15.         AppleEvents, 
  16.  
  17.         InternetConfig;
  18.  
  19.     (* ***** QuickDraw Stuff ***** *)
  20.  
  21.     procedure DrawIcon (resourceID: integer; const iconRect: Rect; drawHighlighted: Boolean);
  22.         (* This routine draws in icon from the resources specified by resourceID.
  23.             If the System 7 icon utilities are available, it uses the icon family
  24.             resources 'icl8', and draws using the icon utilities.  If they're not available,
  25.             it uses the 'ICN#' resource and draws using PlotIcon.
  26.         *)
  27.     
  28.     procedure MagicMarkerMode;
  29.         (* This routine sets the HiliteMode low memory global such that the
  30.             next invert operation is done using the user specified highlight colour.
  31.             If Colour QuickDraw isn't available, it does nothing.
  32.         *)
  33.  
  34.     (* ***** Event Manager Stuff ***** *)
  35.  
  36.     function DirtyKey (typedChar: char): Boolean;
  37.         (* This function returns true if the given character will cause a Text
  38.             Edit field to become dirty, ie it's a character that will go into
  39.             the field rather than move the insertion point.
  40.         *)
  41.         
  42.     function IsKeyDown (keyCode: integer): Boolean;
  43.         (* Returns true if the given virtual key is down. *)
  44.  
  45.     (* ***** Window Manager Stuff ***** *)
  46.  
  47.     (* EnterWindow, ExitWindow and the SavedWindowState type are used to implement
  48.         a standard mechanism for saving and restoring window information.  You call
  49.         EnterWindow when you want to work on a window.  This sets up the parameters
  50.         you need and saves the old parameters in the SavedWindowState variable.
  51.         You then call ExitWindow to restore that state.
  52.     *)
  53.     
  54.     type
  55.         SavedWindowInfo =
  56.             record
  57.                 oldPort: GrafPtr;
  58.                 thisPort: GrafPtr;
  59.                 font: integer;
  60.                 size: integer;
  61.                 face: Style;
  62.             end;
  63.  
  64.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style;
  65.                                                 var saved: SavedWindowInfo);
  66.         (* Set thePort to window and establish the various window state parameters.
  67.             Save the old parameters in saved.
  68.         *)
  69.         
  70.     procedure ExitWindow (const saved: SavedWindowInfo);
  71.         (* Recover the window parameters from saved. *)
  72.  
  73.     function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
  74.         (* Returns the window's content region. This is the region currently
  75.             being used, not a copy.  Do not munge it!
  76.         *)
  77.         
  78.     function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
  79.         (* Returns the window's structure region. This is the region currently
  80.             being used, not a copy.  Do not munge it!
  81.         *)
  82.  
  83.     function TitleBarOnScreen (theWindow: WindowPtr): Boolean;
  84.         (* Returns true if the window's title bar is on the screen.
  85.             Note that this routine only works if the window is visible,
  86.             ie you have called ShowWindow on it.  The standard mechanism
  87.             for using this routine is to ShowWindow the window, then
  88.             call TitleBarOnScreen.  If it returns true, everything is cool.
  89.             Otherwise the window is completely off the screen, so you can
  90.             move it back on without causing visible effects.
  91.         *)
  92.         
  93.     procedure GetWindowRect (theWindow: WindowPtr; var windowRect: Rect);
  94.         (* This routine sets windowRect to the global co-ordinates of 
  95.             the position of the window.  It's typically used for saving window
  96.             state.
  97.         *)
  98.         
  99.     (* ***** Menu Manager Stuff ***** *)
  100.  
  101.     procedure SetMenuItemEnable (menuH: MenuHandle; item: integer; enable: Boolean);
  102.         (* Enable the item in the MenuHandle if enable is set, disable it otherwise.
  103.             You've gotta wonder why this isn't in the operating system!
  104.         *)
  105.         
  106.     function FindMenuItem (menuH: MenuHandle; itemTextToSearchFor: Str255; 
  107.                                                 var indexOfItemFound: integer): Boolean;
  108.         (* This routine searches through the Menu Handle looking for
  109.             itemTextToSearchFor.  If it finds it, it returns true and sets
  110.             indexOfItemFound to the position of the matching menu item.
  111.         *)
  112.  
  113.     (* ***** List Manager Stuff ***** *)
  114.  
  115.     (* All of these List Manager routines are really targetted at one dimensional
  116.         vertical lists.  They don't work well for two dimensional or horizontal
  117.         lists.
  118.     *)
  119.     
  120.     procedure InitListManagerMiscSubs;
  121.         (* The LDoKey function requires a bunch of global state to implement
  122.             it's "select by typing" function. This routine initialises that
  123.             information.
  124.         *)
  125.     
  126.     procedure LSetNoSelection (listH: ListHandle);
  127.         (* This routine clears any selection in the list. *)
  128.  
  129.     procedure LSelectAll(listH: ListHandle);
  130.         (* This routine selects the entire contents of the list. *)
  131.                 
  132.     procedure LSetSingleSelection (listH: ListHandle; row: integer);
  133.         (* This routine selects the single cell (0, row) in the list. *)
  134.  
  135.     (* The LDoKey routine takes a procedural parameter that is uses to fetch
  136.         the text associated with an item in the list so that it can implement
  137.         its "select by typing" function.
  138.     *)
  139.     type
  140.         GetListCellTextProcType = procedure(listH: ListHandle; listCell: Cell; var cellText: Str255);
  141.  
  142.     procedure LDoKey(listH: ListHandle; var event:EventRecord; getCellText: GetListCellTextProcType);
  143.         (* This routine processes a key event associated with a list, including
  144.             "select by typing".  You can disable this function by passing nil to
  145.             getCellText.
  146.         *)
  147.  
  148.     function LSelectedLine (lh: ListHandle): integer;
  149.         (* This function returns the vertical position of the first selected
  150.             cell in the list, or -1 if there is no selected cell.
  151.         *)
  152.  
  153.     function LIsEmpty (lh: ListHandle): Boolean;
  154.         (* This function returns true if the list is empty. *)
  155.         
  156.     (* ***** Truly Misc Stuff ***** *)
  157.  
  158.     function AEGotRequiredParams (const theAppleEvent: AppleEvent): OSStatus;
  159.         (* Returns no error if you've extracted all of the required
  160.             parameters out of the AppleEvent.
  161.         *)
  162.  
  163. implementation
  164.  
  165.     uses
  166.         Icons, 
  167.         Errors, 
  168.         Resources, 
  169.         Dialogs, 
  170.         ToolUtils, 
  171.         Traps, 
  172.         LowMem,
  173.         GestaltEqu,
  174.         StringCompare,
  175.  
  176.         InternetConfig,
  177.         
  178.         ICCommonSubs;
  179.  
  180.     (* ***** QuickDraw Stuff ***** *)
  181.  
  182.     procedure DrawIcon (resourceID: integer; const iconRect: Rect; drawHighlighted: Boolean);
  183.         (* See comment in interface part. *)
  184.         var
  185.             junk: OSStatus;
  186.             iconSuite: Handle;
  187.             transform: integer;
  188.             iconH: Handle;
  189.             tmpIconRect : Rect;
  190.     begin
  191.         tmpIconRect := iconRect;
  192.         if GetIconSuite(iconSuite, resourceID, svAllLargeData) = noErr then begin
  193.             if drawHighlighted then begin
  194.                 transform := ttSelected;
  195.             end else begin
  196.                 transform := ttNone;
  197.             end; (* if *)
  198.             junk := PlotIconSuite(tmpIconRect, 0, transform, iconSuite);
  199.             junk := DisposeIconSuite(iconSuite, false);
  200.         end else begin
  201.             iconH := Get1Resource('ICN#', resourceID);
  202.             if iconH <> nil then begin
  203.                 PlotIcon(tmpIconRect, iconH);
  204.             end; (* if *)
  205.         end; (* if *)
  206.     end; (* DrawIcon *)
  207.  
  208.     procedure MagicMarkerMode;
  209.         (* See comment in interface part. *)
  210.         var
  211.             hasColourQD : Boolean;
  212.             response : longint;
  213.     begin
  214.         hasColourQD := (Gestalt(gestaltQuickdrawVersion, response) = noErr) &
  215.                         (response >= gestalt8BitQD);
  216.         if hasColourQD then begin
  217.             LMSetHiliteMode(band(LMGetHiliteMode, $7F));
  218.         end; (* if *)
  219.     end; (* MagicMarkerMode *)
  220.  
  221.     (* ***** Event Manager Stuff ***** *)
  222.  
  223.     function DirtyKey (typedChar: char): Boolean;
  224.         (* See comment in interface part. *)
  225.     begin
  226.         DirtyKey := not(typedChar in [kHomeChar, kEndChar, kHelpChar, kPageUpChar, kPageDownChar,
  227.                                 kLeftArrowChar, kRightArrowChar, kUpArrowChar, kDownArrowChar]);
  228.     end; (* DirtyKey *)
  229.  
  230.     function IsKeyDown (keyCode: integer): Boolean;
  231.         (* See comment in interface part. *)
  232.         var
  233.             currentKeys: KeyMap;
  234.     begin
  235.         GetKeys(currentKeys);
  236.         IsKeyDown := currentKeys[keyCode];
  237.     end; (* IsKeyDown *)
  238.  
  239.     (* ***** Window Manager Stuff ***** *)
  240.  
  241.     procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style;
  242.                                                 var saved: SavedWindowInfo);
  243.         (* See comment in interface part. *)
  244.     begin
  245.         GetPort(saved.oldPort);
  246.         SetPort(window);
  247.         saved.thisPort := window;
  248.         saved.font := window^.txFont;
  249.         saved.size := window^.txSize;
  250.         saved.face := window^.txFace;
  251.         TextFont(font);
  252.         TextSize(size);
  253.         TextFace(face);
  254.     end; (* EnterWindow *)
  255.  
  256.     procedure ExitWindow (const saved: SavedWindowInfo);
  257.         (* See comment in interface part. *)
  258.     begin
  259.         SetPort(saved.thisPort);
  260.         TextFont(saved.font);
  261.         TextSize(saved.size);
  262.         TextFace(saved.face);
  263.         SetPort(saved.oldPort);
  264.     end; (* ExitWindow *)
  265.  
  266.     function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
  267.         (* See comment in interface part. *)
  268.     begin
  269.         GetWindowContentRegion := WindowPeek(theWindow)^.contRgn;
  270.     end; (* GetWindowContentRegion *)
  271.  
  272.     function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
  273.         (* See comment in interface part. *)
  274.     begin
  275.         GetWindowStructureRegion := WindowPeek(theWindow)^.strucRgn;
  276.     end; (* GetWindowStructureRegion *)
  277.  
  278.     function TitleBarOnScreen (theWindow: WindowPtr): Boolean;
  279.         (* See comment in interface part. *)
  280.         var
  281.             result : Boolean;
  282.             titleBarRegion: RgnHandle;
  283.     begin
  284.         result := true;
  285.         titleBarRegion := NewRgn;
  286.         if titleBarRegion <> nil then begin
  287.             (* First calculate the title bar region by subtracting the content
  288.                 region away from the structure region.
  289.             *)
  290.             CopyRgn(GetWindowStructureRegion(theWindow), titleBarRegion);
  291.             DiffRgn(titleBarRegion, GetWindowContentRegion(theWindow), titleBarRegion);
  292.             
  293.             (* Now intersect the title bar region with the grey region, ie the region
  294.                 describing the extent of the desktop and return true if the intersection
  295.                 is not empty.
  296.             *)
  297.             SectRgn(titleBarRegion, GetGrayRgn, titleBarRegion);
  298.             result := not EmptyRgn(titleBarRegion);
  299.             DisposeRgn(titleBarRegion);
  300.         end; (* if *)
  301.         TitleBarOnScreen := result;
  302.     end; (* TitleBarOnScreen *)
  303.  
  304.     procedure GetWindowRect (theWindow: WindowPtr; var windowRect: Rect);
  305.         (* See comment in interface part. *)
  306.         var
  307.             oldPort : GrafPtr;
  308.     begin
  309.         GetPort(oldPort);
  310.         SetPort(theWindow);
  311.         windowRect := WindowPeek(theWindow)^.port.portRect;
  312.         LocalToGlobal(windowRect.topLeft);
  313.         LocalToGlobal(windowRect.botRight);
  314.         SetPort(oldPort);
  315.     end; (* GetWindowRect *)
  316.  
  317.     (* ***** Menu Manager Stuff ***** *)
  318.  
  319.     procedure SetMenuItemEnable (menuH: MenuHandle; item: integer; enable: Boolean);
  320.         (* See comment in interface part. *)
  321.     begin
  322.         if enable then begin
  323.             EnableItem(menuH, item);
  324.         end else begin
  325.             DisableItem(menuH, item);
  326.         end; (* if *)
  327.     end; (* SetMenuItemEnable *)
  328.  
  329.     function FindMenuItem (menuH: MenuHandle; itemTextToSearchFor: Str255; 
  330.                                                 var indexOfItemFound: integer): Boolean;
  331.         (* See comment in interface part. *)
  332.         var
  333.             itemIndex: integer;
  334.             itemText: Str255;
  335.     begin
  336.         FindMenuItem := false;
  337.         for itemIndex := 1 to CountMItems(menuH) do begin
  338.             GetMenuItemText(menuH, itemIndex, itemText);
  339.             if IdenticalString(itemText, itemTextToSearchFor, nil) = 0 then begin
  340.                 indexOfItemFound := itemIndex;
  341.                 FindMenuItem := true;
  342.             end; (* if *)
  343.         end; (* for *)
  344.     end; (* FindMenuItem *)
  345.  
  346.     (* ***** List Manager Stuff ***** *)
  347.  
  348.     var
  349.         gCharsTypedSoFar: Str255;
  350.         gTimeOfLastCharTyped: longint;
  351.         gListHandleOfLastCharTyped: ListHandle;
  352.  
  353.     procedure InitListManagerMiscSubs;
  354.         (* See comment in interface part. *)
  355.     begin
  356.         gCharsTypedSoFar := '';
  357.         gTimeOfLastCharTyped := 0;
  358.         gListHandleOfLastCharTyped := nil;
  359.     end; (* InitListManagerMiscSubs *)
  360.  
  361.     procedure LSetNoSelection (listH: ListHandle);
  362.         (* See comment in interface part. *)
  363.         var
  364.             listCell: Cell;
  365.     begin
  366.         listCell.v := 0;
  367.         listCell.h := 0;
  368.         while LGetSelect(true, listCell, listH) do begin
  369.             LSetSelect(false, listCell, listH);
  370.             listCell.v := listCell.v + 1;
  371.             listCell.h := 0;
  372.         end; (* if *)
  373.     end; (* LSetNoSelection *)
  374.     
  375.     procedure LSelectAll(listH: ListHandle);
  376.         var
  377.             listCell: Cell;
  378.             row: integer;
  379.     begin
  380.         for row := 0 to listH^^.dataBounds.bottom - 1 do begin
  381.             listCell.v := row;
  382.             listCell.h := 0;
  383.             LSetSelect(true, listCell, listH);
  384.         end; (* for *)
  385.     end; (* LSelectAll *)
  386.  
  387.     procedure LSetSingleSelection (listH: ListHandle; row: integer);
  388.         (* See comment in interface part. *)
  389.         var
  390.             listCell: Cell;
  391.     begin
  392.         listCell.h := 0;
  393.         listCell.v := row;
  394.         LSetSelect(true, listCell, listH);
  395.         listCell.v := 0;
  396.         listCell.h := 0;
  397.         while LGetSelect(true, listCell, listH) do begin
  398.             if listCell.v <> row then begin
  399.                 LSetSelect(false, listCell, listH);
  400.             end; (* if *)
  401.             listCell.v := listCell.v + 1;
  402.             listCell.h := 0;
  403.         end; (* while *)
  404.         LAutoScroll(listH);
  405.     end; (* LSetSingleSelection *)
  406.  
  407.     function LGetUniqueEntryName (listH: ListHandle; listCell: Cell; getCellText: GetListCellTextProcType): Str255;
  408.         (* This function calls getCellText and then returns a 'uniquified' version of the
  409.             cell text.  What that means is that it returns the cell text followed by
  410.             a chr(0) followed by the the vertical co-ordinate of the cell encoded
  411.             as two characters.  This is useful because it allows functions that
  412.             need to distinguish between two cells even if they have the same
  413.             name to function, eg tabbing.
  414.         *)
  415.         var
  416.             result: Str255;
  417.     begin
  418.         result := '';
  419.         getCellText(listH, listCell, result);
  420.         LGetUniqueEntryName := concat(result, chr(0), 
  421.                                                                         chr(listCell.v div 256), 
  422.                                                                         chr(listCell.v mod 256));
  423.     end; (* LGetUniqueEntryName *)
  424.  
  425.     function LGetSelectedCellCommon (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType;
  426.                                                             first : Boolean): Boolean;
  427.         (* This function finds the alphabetically first or last cell (depending
  428.             on the value of first) in the currently selected cells of the list.  It
  429.             returns false if there are no selected cells.
  430.         *)
  431.         var
  432.             result : Boolean;
  433.             cellText: Str255;
  434.             bestText : Str255;
  435.             indexOfBestText: integer;
  436.     begin
  437.         (* Establish some pre-conditions. *)
  438.         result := false;
  439.         listCell.h := 0;
  440.         listCell.v := 0;
  441.         indexOfBestText := 0;
  442.         if first then begin
  443.             bestText := concat(chr(255), chr(255));
  444.         end else begin
  445.             bestText := '';
  446.         end; (* if *)
  447.         
  448.         (* Loop through the selected cells, looking for the best text (ie the
  449.             alphabetically first or last).
  450.         *)
  451.         while LGetSelect(true, listCell, listH) do begin
  452.             result := true;
  453.             getCellText(listH, listCell, cellText);
  454.             if (first & (IUCompString(cellText, bestText) < 0)) |
  455.                         (not first & (IUCompString(cellText, bestText) > 0)) then begin
  456.                 indexOfBestText := listCell.v;
  457.                 bestText := cellText;
  458.             end; (* if *)
  459.             listCell.v := listCell.v + 1;
  460.         end; (* while *)
  461.         
  462.         (* Finish up. *)
  463.         listCell.h := 0;
  464.         listCell.v := indexOfBestText;
  465.         LGetSelectedCellCommon := result;
  466.     end; (* LGetSelectedCellCommon *)
  467.  
  468.     function LGetFirstSelectedCell (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType): Boolean;
  469.         (* This function finds the alphabetically first cell in the currently
  470.             selected cells of the list.  It returns false if there are no selected cells.
  471.         *)
  472.     begin
  473.         LGetFirstSelectedCell := LGetSelectedCellCommon(listH, listCell, getCellText, true);
  474.     end; (* LGetFirstSelectedCell *)
  475.  
  476.     function LGetLastSelectedCell (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType): Boolean;
  477.         (* This function finds the alphabetically last cell in the currently
  478.             selected cells of the list.  It returns false if there are no selected cells.
  479.         *)
  480.     begin
  481.         LGetLastSelectedCell := LGetSelectedCellCommon(listH, listCell, getCellText, false);
  482.     end; (* LGetLastSelectedCell *)
  483.  
  484.     function LSelectFirstCommon (listH: ListHandle; markerText: Str255; getCellText: GetListCellTextProcType;
  485.                                                     before : Boolean; orEqual : Boolean): Boolean;
  486.         (* This function selects the first cell alphabetically before (or after, depending
  487.             on the value of "before") the markerText.  If returns true if it managed to do this,
  488.             false otherwise.  The orEqual value determines whether an
  489.             equal value is considered to be before the otherwise best value.
  490.         *)
  491.         var
  492.             result: Boolean;
  493.             row : integer;
  494.             indexOfBestText: integer;
  495.             listCell: Cell;
  496.             bestText : Str255;
  497.             cellText: Str255;
  498.             comp1 : integer;
  499.             comp2 : integer;
  500.     begin
  501.         (* Establish some pre-conditions. *)
  502.         result := false;
  503.         indexOfBestText := 0;
  504.         if before then begin
  505.             bestText := '';
  506.         end else begin
  507.             bestText := concat(chr(255), chr(255));
  508.         end; (* if *)
  509.         
  510.         (* Iterate through all the cells, looking for best text.  Best is defined
  511.             as the phone that's alphabetically before (or after, depending on
  512.             the value of before) the markerText.
  513.         *)
  514.         for row := 0 to listH^^.dataBounds.bottom - 1 do begin
  515.             listCell.h := 0;
  516.             listCell.v := row;
  517.             getCellText(listH, listCell, cellText);
  518.  
  519.             (* OK, so this needs some explaning (-:
  520.                 comp1 and comp2 just cache the value of the comparisons between
  521.                 markerText, cellText and bestText.
  522.                 
  523.                 If before is true, we're looking for the cell immediately before
  524.                 the markerText.  This means that the markerText must be
  525.                 greater than (ie "comp1 > 0") or equal to (ie "| (comp1 = 0)")
  526.                 the cellText, and the cellText must be greater than (ie "comp2 > 0")
  527.                 the bestText we've found so far.
  528.                 
  529.                 If before is false, we're looking for the cell immediately after
  530.                 the markerText.  This means that the markerText must be
  531.                 less than (ie "comp1 < 0") or equal to (ie "| (comp1 = 0)")
  532.                 the cellText, and the cellText must be less than (ie "comp2 < 0")
  533.                 the bestText we've found so far.
  534.                 
  535.                 *phew*
  536.             *)
  537.             comp1 := IUCompString(markerText, cellText);
  538.             comp2 := IUCompString(cellText, bestText);
  539.             if (        before & (((comp1 > 0) | ((comp1 = 0) & orEqual)) & (comp2 > 0))) |
  540.                 (not before & (((comp1 < 0) | ((comp1 = 0) & orEqual)) & (comp2 < 0))) then begin
  541.                 bestText := cellText;
  542.                 indexOfBestText := listCell.v;
  543.                 result := true;
  544.             end; (* if *)
  545.         end; (* for *)
  546.         
  547.         (* Now set the selection to the cell we found. *)
  548.         if result then begin
  549.             LSetSingleSelection(listH, indexOfBestText);
  550.         end; (* if *)
  551.         LSelectFirstCommon := result;
  552.     end; (* LSelectFirstCommon *)
  553.  
  554.     function LSelectFirstBefore (listH: ListHandle; beforeThis: Str255; getCellText: GetListCellTextProcType): Boolean;
  555.         (* This function selects the first cell alphabetically before
  556.             the beforeThis text.  If returns true if it managed to do this,
  557.             false otherwise.  The orEqual value determines whether an
  558.             equal value is considered to be before the otherwise best value.
  559.         *)
  560.     begin
  561.         LSelectFirstBefore := LSelectFirstCommon(listH, beforeThis, getCellText, true, false);
  562.     end; (* LSelectFirstBefore *)
  563.     
  564.     function LSelectFirstAfter (listH: ListHandle; afterThis: Str255; getCellText: GetListCellTextProcType; orEqual:Boolean): Boolean;
  565.         (* This function selects the first cell alphabetically after
  566.             the afterThis text.  If returns true if it managed to do this,
  567.             false otherwise.  The orEqual value determines whether an
  568.             equal value is considered to be before the otherwise best value.
  569.         *)
  570.     begin
  571.         LSelectFirstAfter := LSelectFirstCommon(listH, afterThis, getCellText, false, orEqual);
  572.     end; (* LSelectFirstAfter *)
  573.  
  574.     procedure LDownArrow(listH : ListHandle);
  575.         (* Find the last selected cell and select the cell after it. *)
  576.         var
  577.             listCell : Cell;
  578.             indexOfCellToSelect : integer;
  579.     begin
  580.         listCell.h := 0;
  581.         listCell.v := 0;
  582.         indexOfCellToSelect := 0;
  583.         while LGetSelect(true, listCell, listH) do begin
  584.             listCell.v := listCell.v + 1;
  585.             indexOfCellToSelect := listCell.v;
  586.         end; (* if *)
  587.         if indexOfCellToSelect >= listH^^.dataBounds.bottom then begin
  588.             indexOfCellToSelect := listH^^.dataBounds.bottom - 1;
  589.         end; (* if *)
  590.         LSetSingleSelection(listH, indexOfCellToSelect);
  591.         LAutoScroll(listH);
  592.     end; (* LDownArrow *)
  593.  
  594.     procedure LUpArrow(listH : ListHandle);
  595.         (* Find the first selected cell and select the cell before it. *)
  596.         var
  597.             listCell : Cell;
  598.     begin
  599.         listCell.h := 0;
  600.         listCell.v := 0;
  601.         if not LGetSelect(true, listCell, listH) then begin
  602.             listCell.v := listH^^.dataBounds.bottom;
  603.         end; (* if *)
  604.         if listCell.v > 0 then begin
  605.             listCell.v := listCell.v - 1;
  606.         end; (* if *)
  607.         LSetSingleSelection(listH, listCell.v);
  608.         LAutoScroll(listH);
  609.     end; (* LUpArrow *)
  610.     
  611.     procedure LTab(listH : ListHandle; getCellText: GetListCellTextProcType; shift : Boolean);
  612.         (* Handle Tab and shift-Tab keys in the list. *)
  613.         var
  614.             junkBool : Boolean;
  615.             listCell : Cell;
  616.             done : Boolean;
  617.             selectedCellText : Str255;
  618.     begin
  619.         if getCellText <> nil then begin
  620.             if not shift then begin
  621.                 (* Tab -- If there are selected cells then attempt to select the first
  622.                     cell after the last selected cell.  If we can't or there were no 
  623.                     selected cells, then select the first cell alphabetically.
  624.                 *)
  625.                 done := false;
  626.                 if LGetLastSelectedCell(listH, listCell, getCellText) then begin
  627.                     selectedCellText := LGetUniqueEntryName(listH, listCell, getCellText);
  628.                     if LSelectFirstAfter(listH, selectedCellText, getCellText, false) then begin
  629.                         done := true;
  630.                     end; (* if *)
  631.                 end; (* if *)
  632.                 if not done then begin
  633.                     junkBool := LSelectFirstAfter(listH, '', getCellText, false);
  634.                 end; (* if *)
  635.             end else begin
  636.                 (* shift-Tab -- If there are no selected cells then attempt to select the
  637.                     cell before the first selected cell.  If we can't or there were no 
  638.                     selected cells, then select the last cell alphabetically.
  639.                 *)
  640.                 done := false;
  641.                 if LGetFirstSelectedCell(listH, listCell, getCellText) then begin
  642.                     getCellText(listH, listCell, selectedCellText);
  643.                     if LSelectFirstBefore(listH, selectedCellText, getCellText) then begin
  644.                         done := true;
  645.                     end; (* if *)
  646.                 end; (* if *)
  647.                 if not done then begin
  648.                     junkBool := LSelectFirstBefore(listH, chr(255), getCellText);
  649.                 end; (* if *)
  650.             end; (* if *)
  651.         end; (* if *)
  652.     end; (* LTab *)
  653.  
  654.     procedure LOtherKey(listH : ListHandle; getCellText : GetListCellTextProcType;
  655.                                             typedChar : char; eventTicks : longint);
  656.         (* This routine handles the pressing of a normaly key in a list
  657.             by selecting the cell best associated with the text typed so far.
  658.         *)
  659.         var
  660.             junkBool : Boolean;
  661.     begin
  662.         if (getCellText <> nil) & (typedChar >= ' ') then begin
  663.             if eventTicks - gTimeOfLastCharTyped > 60 then begin
  664.                 gCharsTypedSoFar := '';
  665.             end; (* if *)
  666.             gTimeOfLastCharTyped := eventTicks;
  667.             gCharsTypedSoFar := concat(gCharsTypedSoFar, typedChar);
  668.             if not LSelectFirstAfter(listH, gCharsTypedSoFar, getCellText, true) then begin
  669.                 junkBool := LSelectFirstBefore(listH, chr(255), getCellText);
  670.             end; (* if *)
  671.         end; (* if *)
  672.     end; (* LOtherKey *)
  673.  
  674.     procedure LDoKey(listH: ListHandle; var event:EventRecord; getCellText: GetListCellTextProcType);
  675.         (* See comment in interface part. *)
  676.         var
  677.             eventTicks: longint;
  678.             typedChar:char;
  679.     begin
  680.         eventTicks := event.when;
  681.         typedChar := chr(band(event.message, charCodeMask));
  682.  
  683.         (* First up, if we've changed lists or typed a control character,
  684.             we reset the globals that track the current typing state.
  685.         *)
  686.         if (gListHandleOfLastCharTyped <> listH) or (typedChar < ' ') then begin
  687.             gTimeOfLastCharTyped := 0;
  688.             gListHandleOfLastCharTyped := listH;
  689.         end; (* if *)
  690.         
  691.         (* Now dispatch the various characters type. *)
  692.         case typedChar of
  693.             (* Handle the trivial scrolling around keys. *)
  694.             kHomeChar:
  695.                 LScroll(0, -listH^^.dataBounds.bottom, listH);
  696.             kEndChar:
  697.                 LScroll(0, listH^^.dataBounds.bottom, listH);
  698.             kPageUpChar:
  699.                 LScroll(0, -(listH^^.visible.bottom - listH^^.visible.top - 2), listH);
  700.             kPageDownChar:
  701.                 LScroll(0, (listH^^.visible.bottom - listH^^.visible.top - 2), listH);
  702.         
  703.             (* Handle up and down arrows. *)
  704.             kDownArrowChar:
  705.                 LDownArrow(listH);
  706.             kUpArrowChar:
  707.                 LUpArrow(listH);
  708.                 
  709.             (* Tab and shift-Tab and other keys are trickier. *)
  710.             kTabChar:
  711.                 LTab(listH, getCellText, band(event.modifiers, shiftKey) <> 0);
  712.             otherwise
  713.                 LOtherKey(listH, getCellText, typedChar, eventTicks);
  714.         end; (* case *)
  715.     end; (* LDoKey *)
  716.  
  717.     function LSelectedLine (lh: ListHandle): integer;
  718.         (* See comment in interface part. *)
  719.         var
  720.             listCell: Cell;
  721.     begin
  722.         SetPt(listCell, 0, 0);
  723.         if LGetSelect(true, listCell, lh) then begin
  724.             LSelectedLine := listCell.v;
  725.         end else begin
  726.             LSelectedLine := -1;
  727.         end; (* if *)
  728.     end; (* LSelectedLine *)
  729.  
  730.     function LIsEmpty (lh: ListHandle): Boolean;
  731.         (* See comment in interface part. *)
  732.     begin
  733.         LIsEmpty := lh^^.dataBounds.bottom <= lh^^.dataBounds.top;
  734.     end; (* LIsEmpty *)
  735.  
  736.     (* ***** Truly Misc Stuff ***** *)
  737.  
  738.     function AEGotRequiredParams (const theAppleEvent: AppleEvent): OSStatus;
  739.         (* See comment in interface part. *)
  740.         var
  741.             typeCode: DescType;
  742.             actualSize: Size;
  743.             err: OSStatus;
  744.             tmpAppleEvent : AppleEvent;
  745.     begin
  746.         tmpAppleEvent := theAppleEvent;
  747.         err := AEGetAttributePtr(tmpAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);
  748.         if err = errAEDescNotFound then begin
  749.             err := noErr;
  750.         end else if err = noErr then begin
  751.             err := errAEEventNotHandled;
  752.         end; (* if *)
  753.         AEGotRequiredParams := err;
  754.     end; (* AEGotRequiredParams *)
  755.  
  756.     function NumToolboxTraps: integer;
  757.         (* Returns the number of toolbox traps on this machine. *)
  758.     begin
  759.         if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then begin
  760.             NumToolboxTraps := $200
  761.         end else begin
  762.             NumToolboxTraps := $400;
  763.         end; (* if *)
  764.     end; (* NumToolboxTraps *)
  765.  
  766.     function GetTrapType (theTrap: integer): TrapType;
  767.         (* Returns the trap type associated with the given A-Trap number. *)
  768.         const
  769.             TrapMask = $0800;
  770.     begin
  771.         if band(theTrap, TrapMask) > 0 then begin
  772.             GetTrapType := ToolTrap
  773.         end else begin
  774.             GetTrapType := OSTrap;
  775.         end; (* if *)
  776.     end; (* GetTrapType *)
  777.  
  778. end. (* ICMiscSubs *)
  779.